home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT19.ZIP / GEN.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-21  |  2KB  |  88 lines
  1. USES crt,dos;
  2.  
  3. VAR source,dest:string;
  4.  
  5.  
  6. function Exist(FileName: String): Boolean;
  7. { Boolean function that returns True if the file exists;otherwise,
  8.  it returns False. Closes the file if it exists. }
  9. var
  10.  F: file;
  11. begin
  12.  {$I-}
  13.  Assign(F, FileName);
  14.  FileMode := 0;  { Set file access to read only }
  15.  Reset(F);
  16.  Close(F);
  17.  {$I+}
  18.  Exist := (IOResult = 0) and (FileName <> '');
  19. end;
  20.  
  21. Procedure GetNames;
  22. BEGIN
  23.   writeln;
  24.   writeln ('Conversion from binary to db...');
  25.   writeln;
  26.   Write ('Enter name of binary file --> ');
  27.   Readln (source);
  28.   if not exist (source) then BEGIN
  29.     Writeln (source,' not found! Exiting ...');
  30.     writeln;
  31.     halt;
  32.   END;
  33.   Write ('Enter name of desination text file --> ');
  34.   Readln (dest);
  35.   writeln;
  36.   writeln ('Working ...');
  37. END;
  38.  
  39. Procedure Convert;
  40. VAR f:text;
  41.     f2:file;
  42.     loop1,loop2,loop3:integer;
  43.     no:byte;
  44.     msg:string;
  45.     dir:dirstr;
  46.     name:namestr;
  47.     ext:extstr;
  48. BEGIN
  49.   assign (f2,source);
  50.   reset (f2,1);
  51.   assign (f,dest);
  52.   rewrite (f);
  53.  
  54.   fsplit (dest, dir, name, ext);
  55.   while length (name)<8 do name:=name+' ';
  56.  
  57.   write (f,name,'  db ');
  58.   loop1:=0;
  59.   loop3:=filesize (f2);
  60.   loop2:=0;
  61.   While not EOF (f2) do BEGIN
  62.     blockread (f2,no,1);
  63.     str (no:3,msg);
  64.     write (f,msg);
  65.     inc (loop1);
  66.     inc (loop2);
  67.     gotoxy (1,wherey);
  68.     write (loop2,'/',loop3);
  69.     if (loop1=16) and (not (eof(f2))) then BEGIN
  70.       loop1:=0;
  71.       writeln(f);
  72.       write (f,'          db ');
  73.     END else
  74.     if not (eof(f2)) then write (f,',');
  75.   END;
  76.  
  77.   close (f);
  78.   close (f2);
  79.   writeln;
  80.  
  81.   writeln ('Done.');
  82. END;
  83.  
  84.  
  85. BEGIN
  86.   Getnames;
  87.   Convert;
  88. END.